home *** CD-ROM | disk | FTP | other *** search
/ Aminet 25 / Aminet 25 (1998)(GTI - Schatztruhe)[!][Jun 1998].iso / Aminet / misc / emu / App8ImU.lha / ImU.p < prev    next >
Encoding:
Text File  |  1998-04-10  |  60.5 KB  |  1,509 lines
  1. program ImageUtility;
  2. {  4/9/98  }
  3.  
  4. {$path "PasI:"}
  5. {$incl "libraries/dos.h" }
  6. {$incl "DOS/DateTime.h" }
  7.  
  8. const addrK = #$96;
  9.       dataK = #$AD;
  10.       secImSize = 143360;
  11.  
  12. type arg = string[64];
  13.      imageDef = (none, notIm, bitIm, secIm);
  14.      orderDef = (oDO, oPO);
  15.      DOSdef = (DOS33, Pascal, ProDOS, dual1, dual2, unknown);
  16.      modeDef = (cat, insert, extract, delete, reord, cvt);
  17.      profileDef = record
  18.                     count,
  19.                     t: byte;
  20.                     data: array[0..7] of record
  21.                                            s,
  22.                                            offs,
  23.                                            v: byte
  24.                                          end
  25.                   end;
  26.      pathN = string[107];
  27.      sector = array[0..255] of byte;
  28.      track = array[0..15] of sector;
  29.  
  30. var firstTime, parmsOK, hit, xlate, indent, writeIt,
  31.     getSize, scanSize, changeSize, scanData, match, done: Boolean;
  32.     volHi, volLo, trkNo, prevT, secNo, TSLt, TSLs, s, AReg, entTyp, byt: byte;
  33.     access, hi, lo, ordCh, ch: char;
  34.     answer, fileSz, newSize, offset, start, firstThree: long;
  35.     argC,
  36.     front, back, count,
  37.     entCount, entSz, mapBlock, totBlocks, blkNo, offs,
  38.     entries, blocks, free, used, largest, unused,
  39.     file_type, stop, size,
  40.     lastTrk, countA, countD,
  41.     i, j, k, m, n: integer;
  42.     ifTyp: imageDef;
  43.     order: orderDef;
  44.     mode: modeDef;
  45.     format: DOSdef;
  46.     option, suffix: string[3];
  47.     fileTyp, kind: string[4];
  48.     volN: string[15];
  49.     mDate, cDate, mTime, cTime: dat_String;
  50.     afName, dirName: string[32];
  51.     currArg, newArg: arg;
  52.     f: BPTR;
  53.     aif: file of byte;
  54.     aof: file;
  55.     dtWork: DateTime;
  56.     ifName, afPath, ofName: pathN;
  57.     args: array[1..16] of arg;
  58.     months: array[0..12] of string[3];
  59.     XORTable: array[$96..$FF] of byte;
  60.     D33_DO, D33_PO, PDOS_DO, PDOS_PO, Pascal_DO, Pascal_PO: profileDef;
  61.     fTypes: array[1..13] of record
  62.                               value: byte;
  63.                               desc: string[3]
  64.                             end;
  65.     rawData: array[0..342] of byte
  66.     LowBits: array[0..85] of byte;
  67.     workSector: sector;
  68.     rearrTrack: track;
  69.     dirEnt: array[0..39] of byte;
  70.     sectors: array[0..34] of track;
  71.     blkAddrs: array[0..255] of word;
  72.     image: array[0..249999] of byte;
  73.  
  74. function secD33(s: byte): byte;
  75.   begin
  76.     if (s = 0) or (s = 15)
  77.         then secD33 := s
  78.       else secD33 := 15 - s
  79.   end;
  80.  
  81. function is(p: profileDef): Boolean;
  82.   var b: Boolean;
  83.       limit, trk, i: integer;
  84.   begin
  85.     b := true;
  86.     trk := p.t;
  87.     for i := 0 to p.count - 1
  88.       do if sectors[trk][p.data[i].s][p.data[i].offs] <> p.data[i].v
  89.              then b := false;
  90.     is := b
  91.   end;
  92.  
  93. function classify(n: pathN): imageDef;
  94.   var fileSize: long;
  95.       lockPtr: BPTR;
  96.       FileIB: p_FileInfoBlock;
  97.   begin
  98.     lockPtr := Lock(n, ACCESS_READ);
  99.     if lockPtr = 0
  100.         then classify := none
  101.       else begin
  102.         new(FileIB);
  103.         answer := Examine(lockPtr, FileIB);
  104.         fileSize := FileIB^.fib_size;
  105.         Unlock(lockPtr);
  106.         dispose(FileIB);
  107.         if fileSize = secImSize
  108.             then begin
  109.               { determine if 'DO' or 'PO' }
  110.               classify := secIm  { default, for now }
  111.             end
  112.           else begin
  113.             if fileSize < secImSize
  114.                 then classify := notIm
  115.               else begin
  116.                 { validate part of file? }
  117.                 classify := bitIm
  118.               end
  119.           end
  120.       end
  121.   end;
  122.  
  123. function un4x4(xx, yy: byte): byte;
  124.   begin
  125.     un4x4 := ((xx and $55) shl 1) + (yy and $55)
  126.   end;
  127.  
  128. function get_dir_byte(o: integer): byte;
  129.   begin
  130.     get_dir_byte := sectors[0][4 + o div 256][o mod 256]
  131.   end;
  132.  
  133. function get_dir_word(o: integer): integer;
  134.   begin
  135.     get_dir_word := get_dir_byte(o + 1) * 256 + get_dir_byte(o)
  136.   end;
  137.  
  138. procedure formatDate(high, low: byte; var d: dat_String);
  139.   var year, month, day: integer;
  140.       temp: dat_String;
  141.   begin
  142.     if high + low = 0
  143.         then temp := '<NO DATE>'
  144.       else begin
  145.         year := high div 2;
  146.         if format = Pascal
  147.             then begin
  148.               month := low mod 16;
  149.               day := low div 16;
  150.               if odd(high)
  151.                   then day := day + 16;
  152.             end
  153.           else begin
  154.             month := low shr 5;
  155.             if odd(high)
  156.                 then month := month + 8;
  157.             day := low and $1F
  158.           end;
  159.         if (month < 1) or (month > 12)
  160.             then month := 0;
  161.         temp := chr(day div 10 + 48) + chr(day mod 10 + 48)
  162.                 + '-' + months[month] + '-'
  163.                 + chr(year div 10 + 48) + chr(year mod 10 + 48);
  164.         if temp[1] = '0'
  165.             then temp[1] := ' '
  166.       end;
  167.     d := temp
  168.   end;
  169.  
  170. procedure formatTime(high, low: byte; var d: dat_String);
  171.   var hour, min: integer;
  172.       temp: dat_String;
  173.   begin
  174.     temp := chr(high div 10 + 48) + chr(high mod 10 + 48)
  175.             + ':'
  176.             + chr(low div 10 + 48) + chr(low mod 10 + 48);
  177.     if temp[1] = '0'
  178.         then temp[1] := ' ';
  179.     d := temp
  180.   end;
  181.  
  182. procedure show_free(f: integer);
  183.   begin
  184.     if f > largest
  185.          then largest := f;
  186.     unused := unused + f;
  187.     writeln('< UNUSED >      ', f:4, '           ', stop:4)
  188.   end;
  189.  
  190. procedure toHex(v: byte; var a, b: char);
  191.   function hexNyb(n: byte): char;
  192.     begin
  193.       if n < 10
  194.           then hexNyb := chr(n + 48)
  195.         else hexNyb := chr(n + 55)
  196.     end;
  197.   begin
  198.     a := hexNyb(v shr 4);
  199.     b := hexNyb(v and $0F)
  200.   end;
  201.  
  202. procedure catalog;
  203.   begin
  204.     case format of
  205.       DOS33: begin
  206.                trkNo := 17;
  207.                secNo := 15;
  208.                writeln('Volume number: ', sectors[17][0][6]);
  209.                writeln('Diskette initialized by version ', sectors[17][0][3]);
  210.                writeln(sectors[17][0][52], ' tracks');
  211.                writeln(sectors[17][0][53], ' sectors');
  212.                writeln(sectors[17][0][55] * 256 + sectors[17][0][54],
  213.                        ' bytes per sector');
  214.                repeat
  215.                  for i := 0 to 6
  216.                    do begin
  217.                      for j := 0 to 34
  218.                        do dirEnt[j] := sectors[trkNo][secNo][i * 35 + j + 11];
  219.                      if (dirEnt[0] > 0) and (dirEnt[0] <> 255)
  220.                          then begin
  221.                            dirName := '';
  222.                            for j := 0 to 29
  223.                              do dirName := dirName + chr(dirEnt[3 + j] and $7F);
  224.                            fileSz := dirEnt[34] * 256 + dirEnt[33];
  225.                            case dirEnt[2] and $7F of
  226.                                0: fileTyp := 'TEXT';
  227.                                1: fileTyp := 'IBAS';
  228.                                2: fileTyp := 'ABAS';
  229.                                4: fileTyp := 'BIN ';
  230.                                8: fileTyp := 'TypS';
  231.                                16: fileTyp := 'RELO';
  232.                                32: fileTyp := 'TypA';
  233.                                64: fileTyp := 'TypB'
  234.                              else fileTyp := 'Unk '
  235.                            end;
  236.                            writeln(dirName, fileSz:6, ' ', fileTyp)
  237.                          end
  238.                    end;
  239.                  prevT := trkNo;
  240.                  trkNo := sectors[prevT][secNo][1];
  241.                  secNo := secD33(sectors[prevT][secNo][2])
  242.                until trkNo = 0;
  243.                writeln
  244.              end;
  245.       Pascal: begin
  246.                 volN := '';
  247.                 for i := 1 to get_dir_byte(6)
  248.                   do volN := volN + chr(get_dir_byte(6 + i));
  249.                 formatDate(sectors[0][4][21], sectors[0][4][20], cDate);
  250.                 writeln(volN, ':              ', cDate);
  251.                 blocks := get_dir_word(14);
  252.                 entries := get_dir_byte(16);
  253.                 unused := 0;
  254.                 largest := 0;
  255.                 stop := 6;
  256.                 for i := 1 to entries
  257.                   do begin
  258.                     offset := i * 26;
  259.                     start := get_dir_word(offset);
  260.                     if (start <> stop)
  261.                         then show_free(start - stop);
  262.                     stop := get_dir_word(offset + 2);
  263.                     file_type := get_dir_word(offset + 4);
  264.                     size := get_dir_byte(offset + 6);
  265.                     dirName := '';
  266.                     for j := 1 to size
  267.                       do dirName := dirName + chr(get_dir_byte(offset + 6 + j));
  268.                     if size < 15
  269.                         then for j := 15 downto size + 1
  270.                                do dirName := dirName + ' ';
  271.                     formatDate(get_dir_byte(offset + 25),
  272.                                get_dir_byte(offset + 24),
  273.                                cDate);
  274.                     write(dirName, ' ', stop - start:4, ' ', cDate, start:5, ' ');
  275.                     case file_type of
  276.                         1: kind := 'Bad ';
  277.                         2: kind := 'Code';
  278.                         3: kind := 'Text';
  279.                         4: kind := 'Typ4';
  280.                         5: kind := 'Data';
  281.                         7: kind := 'Typ7'
  282.                       else kind := '????'
  283.                     end;
  284.                     writeln(kind)
  285.                   end;
  286.                 if stop <> blocks
  287.                     then show_free(blocks - stop);
  288.                 writeln(entries, '/', entries, ' files, ',
  289.                         unused, ' unused, ',
  290.                         largest, ' in largest');
  291.                 writeln
  292.               end;
  293.       ProDOS: begin
  294.                 volN := '/';
  295.                 for i := 1 to sectors[0][4][4] and $0F
  296.                   do volN := volN + chr(sectors[0][4][4 + i]);
  297.                 writeln(volN);
  298.                 writeln;
  299.                 writeln(' NAME           TYPE  BLOCKS  ',
  300.                         'MODIFIED         CREATED          ENDFILE SUBT.');
  301.                 writeln;
  302.                 entCount := sectors[0][4][36];
  303.                 entSz := sectors[0][4][35];
  304.                 blkNo := 2;
  305.                 repeat
  306.                   trkNo := blkNo div 8;
  307.                   secNo := (blkNo * 2) mod 16;
  308.                   for i := 0 {+ firstTime }to entCount - 1
  309.                     do begin
  310.                       for j := 0 to entSz - 1
  311.                         do begin
  312.                           offs := i * entSz + j + 4;
  313.                           dirEnt[j] := sectors[trkNo][secNo + offs div 256][offs mod 256]
  314.                         end;
  315.                       entTyp := dirEnt[0] shr 4;
  316.                       if ((entTyp >= 1) and (entTyp <= 3)) or (entTyp = 13)
  317.                           then begin
  318.                             if dirEnt[30] and $02 = 0
  319.                                 then access := '*'
  320.                               else access := ' ';
  321.                             dirName := '';
  322.                             size := dirEnt[0] and $0F;
  323.                             for j := 1 to size
  324.                               do dirName := dirName + chr(dirEnt[j]);
  325.                             for j := size + 1 to 16
  326.                               do dirName := dirName + ' ';
  327.                             j := 0;
  328.                             repeat
  329.                               J := j + 1;
  330.                               match := dirEnt[16] = fTypes[j].value
  331.                             until match or (j = 13);
  332.                             if match
  333.                                 then fileTyp := fTypes[j].desc
  334.                               else begin
  335.                                 toHex(dirEnt[16], hi, lo);
  336.                                 fileTyp := '$' + hi + lo
  337.                               end;
  338.                             formatDate(dirEnt[34], dirEnt[33], mDate);
  339.                             if mDate = '<NO DATE>'
  340.                                 then mTime := '     '
  341.                               else formatTime(dirEnt[36], dirEnt[35], mTime);
  342.                             formatDate(dirEnt[25], dirEnt[24], cDate);
  343.                             if cDate = '<NO DATE>'
  344.                                 then cTime := '     '
  345.                               else formatTime(dirEnt[27], dirEnt[26], cTime);
  346.                             writeln(access, dirName, fileTyp,
  347.                                     dirEnt[20] * 256 + dirEnt[19]:8,
  348.                                     '  ', mDate, ' ', mTime,
  349.                                     '  ', cDate, ' ', cTime,
  350.                                     dirEnt[23] * 65536 + dirEnt[22] * 256 + dirEnt[21]:9)
  351.                           end
  352.                     end;
  353.                   blkNo := sectors[trkNo][secNo][3] * 256 + sectors[trkNo][secNo][2]
  354.                 until blkNo = 0;
  355.                 writeln;
  356.                 totBlocks := sectors[0][4][42] * 256 + sectors[0][4][41];
  357.                 mapBlock := (sectors[0][4][40] * 256 + sectors[0][4][39]) * 2;
  358.                 free := 0;
  359.                 used := 0;
  360.                 for i := 0 to totBlocks - 1
  361.                   do begin
  362.                     if sectors[0][mapBlock][i div 8] and (1 shl (i mod 8)) = 0
  363.                         then used := used + 1
  364.                       else free := free + 1
  365.                   end;
  366.                 writeln('BLOCKS FREE:', free:5,
  367.                         '     BLOCKS USED:', used:5,
  368.                         '     TOTAL BLOCKS:', totBlocks:5);
  369.                 writeln
  370.               end;
  371.       unknown: writeln('Unknown operating system!')
  372.     end
  373.   end;
  374.  
  375. begin
  376. {$r-}
  377.   for i := $98 to $FF
  378.     do XORTable[i] := 0;
  379.   XORTable[$96] := 0;
  380.   XORTable[$97] := 1;
  381.   XORTable[$9A] := 2;
  382.   XORTable[$9B] := 3;
  383.   XORTable[$9D] := 4;
  384.   XORTable[$9E] := 5;
  385.   XORTable[$9F] := 6;
  386.   XORTable[$A6] := 7;
  387.   XORTable[$A7] := 8;
  388.   XORTable[$AB] := 9;
  389.   XORTable[$AC] := 10;
  390.   XORTable[$AD] := 11;
  391.   XORTable[$AE] := 12;
  392.   XORTable[$AF] := 13;
  393.   XORTable[$B2] := 14;
  394.   XORTable[$B3] := 15;
  395.   XORTable[$B4] := 16;
  396.   XORTable[$B5] := 17;
  397.   XORTable[$B6] := 18;
  398.   XORTable[$B7] := 19;
  399.   XORTable[$B9] := 20;
  400.   XORTable[$BA] := 21;
  401.   XORTable[$BB] := 22;
  402.   XORTable[$BC] := 23;
  403.   XORTable[$BD] := 24;
  404.   XORTable[$BE] := 25;
  405.   XORTable[$BF] := 26;
  406.   XORTable[$CB] := 27;
  407.   XORTable[$CD] := 28;
  408.   XORTable[$CE] := 29;
  409.   XORTable[$CF] := 30;
  410.   XORTable[$D3] := 31;
  411.   XORTable[$D6] := 32;
  412.   XORTable[$D7] := 33;
  413.   XORTable[$D9] := 34;
  414.   XORTable[$DA] := 35;
  415.   XORTable[$DB] := 36;
  416.   XORTable[$DC] := 37;
  417.   XORTable[$DD] := 38;
  418.   XORTable[$DE] := 39;
  419.   XORTable[$DF] := 40;
  420.   XORTable[$E5] := 41;
  421.   XORTable[$E6] := 42;
  422.   XORTable[$E7] := 43;
  423.   XORTable[$E9] := 44;
  424.   XORTable[$EA] := 45;
  425.   XORTable[$EB] := 46;
  426.   XORTable[$EC] := 47;
  427.   XORTable[$ED] := 48;
  428.   XORTable[$EE] := 49;
  429.   XORTable[$EF] := 50;
  430.   XORTable[$F2] := 51;
  431.   XORTable[$F3] := 52;
  432.   XORTable[$F4] := 53;
  433.   XORTable[$F5] := 54;
  434.   XORTable[$F6] := 55;
  435.   XORTable[$F7] := 56;
  436.   XORTable[$F9] := 57;
  437.   XORTable[$FA] := 58;
  438.   XORTable[$FB] := 59;
  439.   XORTable[$FC] := 60;
  440.   XORTable[$FD] := 61;
  441.   XORTable[$FE] := 62;
  442.   XORTable[$FF] := 63;
  443.   D33_DO.count := 4;
  444.   D33_DO.t := 17;
  445.   D33_DO.data[0].s := 0;
  446.   D33_DO.data[0].offs := 1;
  447.   D33_DO.data[0].v := 17;
  448.   D33_DO.data[1].s := 0;
  449.   D33_DO.data[1].offs := 2;
  450.   D33_DO.data[1].v := 15;
  451.   D33_DO.data[2].s := 2;
  452.   D33_DO.data[2].offs := 1;
  453.   D33_DO.data[2].v := 17;
  454.   D33_DO.data[3].s := 2;
  455.   D33_DO.data[3].offs := 2;
  456.   D33_DO.data[3].v := 1;
  457.   D33_PO.count := 4;
  458.   D33_PO.t := 17;
  459.   D33_PO.data[0].s := 0;
  460.   D33_PO.data[0].offs := 1;
  461.   D33_PO.data[0].v := 17;
  462.   D33_PO.data[1].s := 0;
  463.   D33_PO.data[1].offs := 2;
  464.   D33_PO.data[1].v := 15;
  465.   D33_PO.data[2].s := 13;
  466.   D33_PO.data[2].offs := 1;
  467.   D33_PO.data[2].v := 17;
  468.   D33_PO.data[3].s := 13;
  469.   D33_PO.data[3].offs := 2;
  470.   D33_PO.data[3].v := 1;
  471.   Pascal_DO.count := 5;
  472.   Pascal_DO.t := 0;
  473.   Pascal_DO.data[0].s := 11;
  474.   Pascal_DO.data[0].offs := 0;
  475.   Pascal_DO.data[0].v := 0;
  476.   Pascal_DO.data[1].s := 11;
  477.   Pascal_DO.data[1].offs := 1;
  478.   Pascal_DO.data[1].v := 0;
  479.   Pascal_DO.data[2].s := 11;
  480.   Pascal_DO.data[2].offs := 2;
  481.   Pascal_DO.data[2].v := 6;
  482.   Pascal_DO.data[3].s := 11;
  483.   Pascal_DO.data[3].offs := 14;
  484.   Pascal_DO.data[3].v := 24;
  485.   Pascal_DO.data[4].s := 11;
  486.   Pascal_DO.data[4].offs := 15;
  487.   Pascal_DO.data[4].v := 1;
  488.   Pascal_PO.count := 5;
  489.   Pascal_PO.t := 0;
  490.   Pascal_PO.data[0].s := 4;
  491.   Pascal_PO.data[0].offs := 0;
  492.   Pascal_PO.data[0].v := 0;
  493.   Pascal_PO.data[1].s := 4;
  494.   Pascal_PO.data[1].offs := 1;
  495.   Pascal_PO.data[1].v := 0;
  496.   Pascal_PO.data[2].s := 4;
  497.   Pascal_PO.data[2].offs := 2;
  498.   Pascal_PO.data[2].v := 6;
  499.   Pascal_PO.data[3].s := 4;
  500.   Pascal_PO.data[3].offs := 14;
  501.   Pascal_PO.data[3].v := 24;
  502.   Pascal_PO.data[4].s := 4;
  503.   Pascal_PO.data[4].offs := 15;
  504.   Pascal_PO.data[4].v := 1;
  505.   PDOS_DO.count := 8;
  506.   PDOS_DO.t := 0;
  507.   PDOS_DO.data[0].s := 11;
  508.   PDOS_DO.data[0].offs := 0;
  509.   PDOS_DO.data[0].v := 0;
  510.   PDOS_DO.data[1].s := 11;
  511.   PDOS_DO.data[1].offs := 2;
  512.   PDOS_DO.data[1].v := 3;
  513.   PDOS_DO.data[2].s := 9;
  514.   PDOS_DO.data[2].offs := 0;
  515.   PDOS_DO.data[2].v := 2;
  516.   PDOS_DO.data[3].s := 9;
  517.   PDOS_DO.data[3].offs := 2;
  518.   PDOS_DO.data[3].v := 4;
  519.   PDOS_DO.data[4].s := 7;
  520.   PDOS_DO.data[4].offs := 0;
  521.   PDOS_DO.data[4].v := 3;
  522.   PDOS_DO.data[5].s := 7;
  523.   PDOS_DO.data[5].offs := 2;
  524.   PDOS_DO.data[5].v := 5;
  525.   PDOS_DO.data[6].s := 5;
  526.   PDOS_DO.data[6].offs := 0;
  527.   PDOS_DO.data[6].v := 4;
  528.   PDOS_DO.data[7].s := 5;
  529.   PDOS_DO.data[7].offs := 2;
  530.   PDOS_DO.data[7].v := 0;
  531.   PDOS_PO.count := 8;
  532.   PDOS_PO.t := 0;
  533.   PDOS_PO.data[0].s := 4;
  534.   PDOS_PO.data[0].offs := 0;
  535.   PDOS_PO.data[0].v := 0;
  536.   PDOS_PO.data[1].s := 4;
  537.   PDOS_PO.data[1].offs := 2;
  538.   PDOS_PO.data[1].v := 3;
  539.   PDOS_PO.data[2].s := 6;
  540.   PDOS_PO.data[2].offs := 0;
  541.   PDOS_PO.data[2].v := 2;
  542.   PDOS_PO.data[3].s := 6;
  543.   PDOS_PO.data[3].offs := 2;
  544.   PDOS_PO.data[3].v := 4;
  545.   PDOS_PO.data[4].s := 8;
  546.   PDOS_PO.data[4].offs := 0;
  547.   PDOS_PO.data[4].v := 3;
  548.   PDOS_PO.data[5].s := 8;
  549.   PDOS_PO.data[5].offs := 2;
  550.   PDOS_PO.data[5].v := 5;
  551.   PDOS_PO.data[6].s := 10;
  552.   PDOS_PO.data[6].offs := 0;
  553.   PDOS_PO.data[6].v := 4;
  554.   PDOS_PO.data[7].s := 10;
  555.   PDOS_PO.data[7].offs := 2;
  556.   PDOS_PO.data[7].v := 0;
  557.   months[0] := '???';
  558.   months[1] := 'Jan';
  559.   months[2] := 'Feb';
  560.   months[3] := 'Mar';
  561.   months[4] := 'Apr';
  562.   months[5] := 'May';
  563.   months[6] := 'Jun';
  564.   months[7] := 'Jul';
  565.   months[8] := 'Aug';
  566.   months[9] := 'Sep';
  567.   months[10] := 'Oct';
  568.   months[11] := 'Nov';
  569.   months[12] := 'Dec';
  570.   fTypes[1].value := $01;
  571.   fTypes[1].desc := 'BAD';
  572.   fTypes[2].value := $04;
  573.   fTypes[2].desc := 'TXT';
  574.   fTypes[3].value := $06;
  575.   fTypes[3].desc := 'BIN';
  576.   fTypes[4].value := $0F;
  577.   fTypes[4].desc := 'DIR';
  578.   fTypes[5].value := $19;
  579.   fTypes[5].desc := 'ADB';
  580.   fTypes[6].value := $1A;
  581.   fTypes[6].desc := 'AWP';
  582.   fTypes[7].value := $1B;
  583.   fTypes[7].desc := 'ASP';
  584.   fTypes[8].value := $EF;
  585.   fTypes[8].desc := 'PAS';
  586.   fTypes[9].value := $F0;
  587.   fTypes[9].desc := 'CMD';
  588.   fTypes[10].value := $FC;
  589.   fTypes[10].desc := 'BAS';
  590.   fTypes[11].value := $FD;
  591.   fTypes[11].desc := 'VAR';
  592.   fTypes[12].value := $FE;
  593.   fTypes[12].desc := 'REL';
  594.   fTypes[13].value := $FF;
  595.   fTypes[13].desc := 'SYS';
  596. {$r+}
  597.   dtWork.dat_Format := FORMAT_DOS;
  598.   dtWork.dat_Flags := 0;
  599.   dtWork.dat_StrDay := NIL;
  600.   dtWork.dat_StrDate := ^mDate;
  601.   dtWork.dat_StrTime := ^mTime;
  602.   clrscr;
  603.   writeln;
  604.   writeln('Apple Image Utility - version 0.6');
  605.   writeln;
  606.   parmsOK := true;
  607.   argC := ParamCount;
  608.   if argC > 16
  609.       then argC := 16;
  610.   for i := 1 to argC
  611.     do args[i] := ParamStr(i);
  612.   if argC > 2
  613.       then begin
  614.         ch := args[3][1];
  615.         if (ch = '''') or (ch = '"')
  616.             then begin
  617.               i := 2;
  618.               newArg := '';
  619.               repeat
  620.                 i := i + 1;
  621.                 currArg := args[i];
  622.                 newArg := newArg + currArg + ' ';
  623.                 ch := currArg[length(currArg)];
  624.                 done := (ch = '''') or (ch = '"')
  625.               until done or (i = argC);
  626.               if done
  627.                   then begin
  628.                     newArg := copy(newArg, 2, length(newArg) - 3);
  629.                     args[3] := newArg;
  630.                     if i = argC
  631.                         then argC := 3
  632.                       else begin
  633.                         for j := i + 1 to argC
  634.                           do args[3 + j - i] := args[j];
  635.                         argC := argC - 3
  636.                       end
  637.                   end
  638.             end
  639.       end;
  640.   case argC of
  641.       0: begin
  642.            write('File name? ');
  643.            readln(ifName);
  644.            ifTyp := classify(ifName);
  645.            mode := cat
  646.          end;
  647.       1: begin
  648.            ifName := args[1];
  649.            ifTyp := classify(ifName);
  650.            mode := cat
  651.          end;
  652.       2: begin
  653.            ifName := args[1];
  654.            ifTyp := classify(ifName);
  655.            if (args[2] = '-r') or (args[2] = '-R')
  656.                then begin
  657.                  if ifTyp = bitIm
  658.                      then begin
  659.                        writeln('Can''t reorder bit image!');
  660.                        parmsOK := false
  661.                      end
  662.                    else begin
  663.                      if size <> 2
  664.                          then parmsOK := false
  665.                        else begin
  666.                          ofName := ifName + '.ro';
  667.                          mode := reord
  668.                        end
  669.                    end
  670.                end
  671.              else if (args[2] = '-c') or (args[2] = '-C')
  672.                       then begin
  673.                         if ifTyp <> bitIm
  674.                             then begin
  675.                               writeln('Can''t convert sector image!');
  676.                               parmsOK := false
  677.                             end
  678.                           else begin
  679.                             ofName := ifName + '.si';
  680.                             mode := cvt
  681.                           end
  682.                       end
  683.              else parmsOK := false
  684.          end;
  685.       3: begin
  686.            ifName := args[1];
  687.            ifTyp := classify(ifName);
  688.            option := args[2];
  689.            size := length(option);
  690.            if option[1] <> '-'
  691.                then parmsOK := false
  692.              else begin
  693.                case option[2] of
  694.                    'i',
  695.                    'I': begin
  696.                           afName := args[3];
  697.                           assign(aif, afName);
  698.                           {$i-}
  699.                           reset(aif);
  700.                           {$i+}
  701.                           if IOResult <> 0
  702.                               then begin
  703.                                 writeln('Can''t open ''', afName, '''!');
  704.                                 parmsOK := false
  705.                               end
  706.                             else begin
  707.                               close(aif);
  708.                               afPath := afName;
  709.                               i := length(afPath);
  710.                               repeat
  711.                                 ch := afPath[i];
  712.                                 hit := (ch = ':') or (ch = '/') or (ch = '\');
  713.                                 if not hit
  714.                                     then i := i - 1
  715.                               until (i = 0) or hit;
  716.                               if hit
  717.                                   then afName := copy(afPath, i + 1, length(afPath) - i);
  718.                             end;
  719.                           if size = 2
  720.                               then xlate := false
  721.                             else if size <> 3
  722.                                      then parmsOK := false
  723.                             else if UpCase(option[3]) <> 'T'
  724.                                      then parmsOK := false
  725.                             else xlate := true;
  726.                           mode := insert
  727.                         end;
  728.                    'x',
  729.                    'X': begin
  730.                           afName := args[3];
  731.                           for i := 1 to length(afName)
  732.                             do afName[i] := UpCase(afName[i]);
  733.                           if size = 2
  734.                               then xlate := false
  735.                             else if size <> 3
  736.                                      then parmsOK := false
  737.                             else if UpCase(option[3]) <> 'T'
  738.                                      then parmsOK := false
  739.                             else xlate := true;
  740.                           mode := extract
  741.                         end;
  742.                    'd',
  743.                    'D': begin
  744.                           afName := args[3];
  745.                           for i := 1 to length(afName)
  746.                             do afName[i] := UpCase(afName[i]);
  747.                           if size <> 2
  748.                               then parmsOK := false
  749.                             else mode := delete
  750.                         end;
  751.                    'c',
  752.                    'C': begin
  753.                         if ifTyp <> bitIm
  754.                             then begin
  755.                               writeln('Can''t convert sector image!');
  756.                               parmsOK := false
  757.                             end
  758.                           else begin
  759.                             if size <> 2
  760.                                 then parmsOK := false
  761.                               else begin
  762.                                 ofName := args[3];
  763.                                 mode := cvt
  764.                               end
  765.                           end
  766.                         end;
  767.                    'r',
  768.                    'R': begin
  769.                           if ifTyp = bitIm
  770.                               then begin
  771.                                 writeln('Can''t reorder bit image!');
  772.                                 parmsOK := false
  773.                               end
  774.                             else begin
  775.                               if size <> 2
  776.                                   then parmsOK := false
  777.                                 else begin
  778.                                   ofName := args[3];
  779.                                   mode := reord
  780.                                 end
  781.                             end
  782.                         end
  783.                  else parmsOK := false
  784.                end
  785.              end
  786.          end
  787.     else parmsOK := false
  788.   end;
  789.   if not parmsOK
  790.       then begin
  791.         writeln('  Usage:');
  792.         writeln('    "ImU" - Directory listing of diskette image file');
  793.         writeln('    "ImU ifN" - Directory listing of "ifN"');
  794.         writeln('    "ImU ifN -x mfN" - Extract "mfN" from "ifN"');
  795.         writeln('    "ImU ifN -xt mfN" - ''-x'' plus translate ''EOL''');
  796.         writeln('    "ImU ifN -i fN" - Insert "fN" into "ifN"');
  797.         writeln('    "ImU ifN -it fN" - ''-i'' plus translate ''EOL''');
  798.         writeln('    "ImU ifN -d mfN" - Delete "mfN" from "ifN"');
  799.         writeln('    "ImU ifN -r" - Reorder "ifN" creating "ifN.ro"');
  800.         writeln('    "ImU ifN -r ofN" - Reorder "ifN" creating "ofN"');
  801.         writeln('    "ImU ifN -c" - Convert "ifN" to "ifN.si"');
  802.         writeln('    "ImU ifN -c ofN" - Convert "ifN" to "ofN"');
  803.         halt(20)
  804.       end;
  805.   if ifTyp < bitIm
  806.       then begin
  807.         writeln('File missing or not image file!');
  808.         halt(20)
  809.       end;
  810.   case mode of
  811.     cat: ;
  812.     insert: begin
  813.               writeln('Can''t insert a file into an image yet!');
  814.               halt(20)
  815.             end;
  816.     extract: begin
  817.                writeln('Attempting to extract ''', afName,
  818.                        ''' from ''', ifName, '''');
  819.                writeln
  820.              end;
  821.     delete: begin
  822.               writeln('Can''t delete a file from an image yet!');
  823.               halt(20)
  824.             end;
  825.     reord: writeln('Reordering sector image file:');
  826.     cvt: begin
  827.            writeln('Converting bit image file ''', ifName,
  828.                    ''' as sector image file ''',  ofName, '''')
  829.          end
  830.   end;
  831.   if ifTyp <> bitIm
  832.       then begin  { Load sector image file }
  833.         f := Open(ifName, MODE_OLDFILE);
  834.         if f = 0
  835.             then begin
  836.               writeln('Illogical error while opening ''', ifName, '''!');
  837.               halt(20)
  838.             end;
  839.         if _Read(f, ^sectors, secImSize) <> secImSize
  840.             then begin
  841.               writeln('Error reading ''', ifName, '''!');
  842.               _Close(f);
  843.               halt(20)
  844.             end;
  845.         _Close(f);
  846.       end  { Load sector image file }
  847.     else begin  { Load bit image file }
  848.       f := Open(ifName, MODE_OLDFILE);
  849.       if f = 0
  850.           then begin
  851.             writeln('Couldn''t find ''', ifName, '''!');
  852.             halt(20)
  853.           end;
  854.       fileSz :=  _Read(f, ^image, 250000);
  855.       _Close(f);
  856.       firstTime := true;
  857.       lastTrk := -1;
  858.       countA := 0;
  859.       countD := 0;
  860.       offset := 0;
  861.       done := false;
  862.       scanData := false;
  863.       repeat
  864.         if image[offset] = $D5
  865.             then if image[offset + 1] = $AA
  866.                      then if image[offset + 2] = $96
  867.                               then begin
  868.                                 if scanData
  869.                                     then begin
  870.                                       writeln;
  871.                                       writeln('Address/Data field sequence error!')
  872.                                     end;
  873.                                 if firstTime
  874.                                     then begin
  875.                                       volHi := image[offset + 3];
  876.                                       volLo := image[offset + 4]
  877.                                       firstTime := false
  878.                                     end
  879.                                   else if (image[offset + 3] <> volHi)
  880.                                           or (image[offset + 4] <> volLo)
  881.                                            then begin
  882.                                              writeln;
  883.                                              writeln('Volume number mismatch!')
  884.                                            end;
  885.                                 trkNo := un4x4(image[offset + 5], image[offset + 6]);
  886.                                 secNo := un4x4(image[offset + 7], image[offset + 8]);
  887.                                 if trkNo <> lastTrk
  888.                                     then begin
  889.                                       lastTrk := trkNo;
  890.                                       if trkNo mod 7 = 0
  891.                                           then writeln;
  892.                                       write(trkNo:3)
  893.                                     end;
  894.                                 if not ((image[offset + 11] = $DE)
  895.                                         and (image[offset + 12] = $AA)
  896.                                        {and (image[offset + 13] = $EB)})
  897.                                     then begin
  898.                                       writeln;
  899.                                       writeln('Address field epilogue error!')
  900.                                     end;
  901.                                 offset := offset + 12;
  902.                                 countA := countA + 1;
  903.                                 scanData := true
  904.                               end
  905.                             else if image[offset + 2] = $AD
  906.                                  then begin
  907.                                    if not scanData
  908.                                        then begin
  909.                                          writeln;
  910.                                          writeln('Address/Data field sequence error!')
  911.                                        end;
  912.                                    if not ((image[offset + 346] = $DE)
  913.                                            and (image[offset + 347] = $AA)
  914.                                           {and (image[offset + 348] = $EB)})
  915.                                        then begin
  916.                                          writeln;
  917.                                          writeln(image[offset + 346]:4, image[offset + 347]:4,
  918.                                                  ' Data field epilogue error!')
  919.                                        end
  920.                                      else begin
  921.                                        for j := 0 to 342
  922.                                          do rawData[j] := image[offset + 3 + j];
  923.                                        AReg := 0;
  924.                                        for j := 0 to 85
  925.                                          do begin
  926.                                            AReg := AReg xor XORTable[rawData[j]];
  927.                                            LowBits[85 - j] := AReg
  928.                                          end;
  929.                                        for j := 86 to 341
  930.                                          do begin
  931.                                            AReg := AReg xor XORTable[rawData[j]];
  932.                                            workSector[j - 86] := AReg
  933.                                          end;
  934.                                        AReg := AReg xor XORTable[rawData[342]];
  935.                                        if AReg <> 0
  936.                                            then begin
  937.                                              writeln(' Checksum error!')
  938.                                              halt(20)
  939.                                            end;
  940.                                        k := 0;
  941.                                        for j := 0 to 255
  942.                                          do begin
  943.                                            k := k - 1;
  944.                                            if k < 0
  945.                                                then k := 85;
  946.                                            AReg := LowBits[k] and 1;
  947.                                            AReg := AReg shl 1;
  948.                                            LowBits[k] := LowBits[k] shr 1;
  949.                                            AReg := AReg + (LowBits[k] and 1);
  950.                                            LowBits[k] := LowBits[k] shr 1;
  951.                                            workSector[j] := workSector[j] shl 2 + AReg
  952.                                          end
  953.                                        sectors[trkNo][(secNo mod 2) * 8 + secNo div 2] := workSector;
  954.                                      end;
  955.                                    offset := offset + 348;
  956.                                    countD := countD + 1;
  957.                                    scanData := false
  958.                                  end
  959.                             else begin
  960.                               writeln;
  961.                               writeln('Invalid byte after ''$D5AA''!')
  962.                             end;
  963.         offset := offset + 1
  964.       until (offset = fileSz) or done;
  965.       writeln;
  966.       writeln;
  967.       if (countA <> 560) or (countD <> 560)
  968.           then begin
  969.             writeln('Found ', countA, ' address fields!');
  970.             writeln('Found ', countD, ' data fields!')
  971.           end;
  972.       order := oPO
  973.     end;  { Load bit image file }
  974.   if is(PDOS_PO)
  975.       then begin
  976.         if is(D33_PO)
  977.             then format := dual1
  978.           else format := ProDOS;
  979.         order := oPO
  980.       end
  981.     else if is(PDOS_DO)
  982.              then begin
  983.                if is(D33_DO)
  984.                    then format := dual1
  985.                  else format := ProDOS;
  986.                order := oDO
  987.              end
  988.     else if is(Pascal_PO)
  989.              then begin
  990.                if is(D33_PO)
  991.                    then format := dual2
  992.                  else format := Pascal;
  993.                order := oPO
  994.              end
  995.     else if is(Pascal_DO)
  996.              then begin
  997.                if is(D33_DO)
  998.                    then format := dual2
  999.                  else format := Pascal;
  1000.                order := oDO
  1001.              end
  1002.     else if is(D33_PO)
  1003.              then begin
  1004.                format := DOS33;
  1005.                order := oPO
  1006.              end
  1007.     else if is(D33_DO)
  1008.              then begin
  1009.                format := DOS33;
  1010.                order := oDO
  1011.              end
  1012.     else format := unknown;
  1013.   if order = oDO
  1014.       then for i := 0 to 34
  1015.              do begin
  1016.                rearrTrack[0] := sectors[i][0];
  1017.                rearrTrack[1] := sectors[i][14];
  1018.                rearrTrack[2] := sectors[i][13];
  1019.                rearrTrack[3] := sectors[i][12];
  1020.                rearrTrack[4] := sectors[i][11];
  1021.                rearrTrack[5] := sectors[i][10];
  1022.                rearrTrack[6] := sectors[i][9];
  1023.                rearrTrack[7] := sectors[i][8];
  1024.                rearrTrack[8] := sectors[i][7];
  1025.                rearrTrack[9] := sectors[i][6];
  1026.                rearrTrack[10] := sectors[i][5];
  1027.                rearrTrack[11] := sectors[i][4];
  1028.                rearrTrack[12] := sectors[i][3];
  1029.                rearrTrack[13] := sectors[i][2];
  1030.                rearrTrack[14] := sectors[i][1];
  1031.                rearrTrack[15] := sectors[i][15];
  1032.                sectors[i] := rearrTrack
  1033.              end;
  1034.   case mode of
  1035.     cat: begin
  1036.            if order = oPO
  1037.                then ordCh := 'P'
  1038.              else ordCh := 'D';
  1039.            if (format = dual1) or (format = dual2)
  1040.                then suffix := 'ies'
  1041.              else suffix := 'y';
  1042.            if ifTyp > bitIm
  1043.                then begin
  1044.                  writeln('Displaying director', suffix, ' of ''', ifName,
  1045.                          ''' (', ordCh, 'O order)');
  1046.                  writeln
  1047.                end;
  1048.            if format = dual2
  1049.                then begin
  1050.                  writeln('Pascal side:');
  1051.                  writeln;
  1052.                  format := Pascal;
  1053.                  catalog;
  1054.                  writeln('DOS 3.3 side:');
  1055.                  writeln;
  1056.                  format := DOS33;
  1057.                  catalog
  1058.                end
  1059.              else if format = dual1
  1060.                       then begin
  1061.                         writeln('ProDOS side:');
  1062.                         writeln;
  1063.                         format := ProDOS;
  1064.                         catalog;
  1065.                         writeln('DOS 3.3 side:');
  1066.                         writeln;
  1067.                         format := DOS33;
  1068.                         catalog
  1069.                       end
  1070.              else catalog
  1071.          end;
  1072.     insert: begin
  1073.             end;
  1074.     extract: begin
  1075.                if (format = dual1) or (format = dual2)
  1076.                    then begin
  1077.                      write('Extract from the DOS 3.3 side? ');
  1078.                      readln(ch);
  1079.                      if UpCase(ch) = 'Y'
  1080.                          then format := DOS33
  1081.                        else if format = dual1
  1082.                                 then format := ProDOS
  1083.                               else format := Pascal;
  1084.                      writeln
  1085.                    end
  1086.                  else catalog;
  1087.                case format of
  1088.                  unknown: ;
  1089.                  DOS33: begin
  1090.                           trkNo := 17;
  1091.                           secNo := 15;
  1092.                           repeat
  1093.                             i := 0;
  1094.                             repeat
  1095.                               for j := 0 to 34
  1096.                                 do dirEnt[j] := sectors[trkNo][secNo][i * 35 + j + 11];
  1097.                               if (dirEnt[0] > 0) and (dirEnt[0] <> 255)
  1098.                                   then begin
  1099.                                     dirName := '';
  1100.                                     for j := 0 to 29
  1101.                                       do dirName := dirName + UpCase(chr(dirEnt[3 + j] and $7F));
  1102.                                     while dirName[length(dirName)] = ' '
  1103.                                       do dirName := copy(dirName, 1, length(dirName) - 1);
  1104.                                     match := afName = dirName
  1105.                                   end;
  1106.                               i := i + 1
  1107.                             until (i = 7) or match;
  1108.                             if not match
  1109.                                 then begin
  1110.                                   prevT := trkNo;
  1111.                                   trkNo := sectors[prevT][secNo][1];
  1112.                                   secNo := secD33(sectors[prevT][secNo][2])
  1113.                                 end
  1114.                           until (trkNo = 0) or match;
  1115.                           if not match
  1116.                               then begin
  1117.                                 writeln('Can''t locate ''', afName, ''' in ''', ifName, '''');
  1118.                                 writeln
  1119.                               end
  1120.                             else begin
  1121. {
  1122.                               fileSz := (dirEnt[34] * 256 + dirEnt[33]) * 256;
  1123. }
  1124.                               scanSize := false;
  1125.                               getSize := false;
  1126.                               case dirEnt[2] and $7F of
  1127.                                   0: begin
  1128.                                        fileSz := 0;
  1129.                                        scanSize := true
  1130.                                      end;
  1131.                                   1,
  1132.                                   2: begin
  1133.                                        offset := 0;
  1134.                                        getSize := true
  1135.                                      end;
  1136.                                   4: begin
  1137.                                        offset := 2;
  1138.                                        getSize := true
  1139.                                      end;
  1140.                                 else { Do nothing }
  1141.                               end;
  1142.                               changeSize := scanSize or getSize;
  1143.                               assign(aof, dirName);
  1144.                               rewrite(aof);
  1145.                               { get address of 1st T/S list sector }
  1146.                               TSLt := dirEnt[0];
  1147.                               TSLs := secD33(dirEnt[1]);
  1148.                               while TSLt + TSLs <> 0
  1149.                                 do begin
  1150.                                   for i := 6 to 127
  1151.                                     do begin
  1152.                                       trkNo := sectors[TSLt][TSLs][i * 2];
  1153.                                       secNo := secD33(sectors[TSLt][TSLs][i * 2 + 1]);
  1154.                                       if trkNo + secNo <> 0
  1155.                                           then begin
  1156.                                             if scanSize
  1157.                                                 then begin
  1158.                                                   j := 0;
  1159.                                                   repeat
  1160.                                                     if sectors[trkNo][secNo][j] = 0
  1161.                                                         then scanSize := false
  1162.                                                       else j := j + 1
  1163.                                                   until not scanSize or (j = 256);
  1164.                                                   if scanSize
  1165.                                                       then fileSz := fileSz + 256
  1166.                                                     else fileSz := fileSz + j
  1167.                                                 end
  1168.                                               else if getSize
  1169.                                                        then begin
  1170.                                                          fileSz := sectors[trkNo][secNo][offset + 1] * 256
  1171.                                                                    + sectors[trkNo][secNo][offset]
  1172.                                                                    + 2
  1173.                                                                    + offset;
  1174.                                                          getSize := false
  1175.                                                        end;
  1176.                                             if not xlate
  1177.                                                 then BlockWrite(aof, sectors[trkNo][secNo], 2)
  1178.                                               else begin
  1179.                                                 for j := 0 to 255
  1180.                                                   do begin
  1181.                                                     byt := sectors[trkNo][secNo][j] and $7F;
  1182.                                                     if byt = $0D
  1183.                                                         then byt := $0A;
  1184.                                                     workSector[j] := byt
  1185.                                                   end;
  1186.                                                 BlockWrite(aof, workSector, 2)
  1187.                                               end
  1188.                                           end
  1189.                                     end
  1190.                                   trkNo := sectors[TSLt][TSLs][1];
  1191.                                   TSLs := secD33(sectors[TSLt][TSLs][2]);
  1192.                                   TSLt := trkNo
  1193.                                 end;
  1194.                               close(aof);
  1195.                               if changeSize
  1196.                                   then begin
  1197.                                     f := Open(dirName, MODE_OLDFILE);
  1198.                                     newSize := SetFileSize(f, fileSz, OFFSET_BEGINNING);
  1199.                                     if newSize <> fileSz
  1200.                                         then writeln('However unlikely, setting output file size failed!');
  1201.                                     _Close(f)
  1202.                                   end
  1203.                             end
  1204.                         end;
  1205.                  Pascal: begin
  1206.                            entries := get_dir_byte(16);
  1207.                            i := 0;
  1208.                            repeat
  1209.                              i := i + 1;
  1210.                              offset := i * 26;
  1211.                              size := get_dir_byte(offset + 6);
  1212.                              dirName := '';
  1213.                              for j := 1 to size
  1214.                                do dirName := dirName + UpCase(chr(get_dir_byte(offset + 6 + j)));
  1215.                              match := afName = dirName
  1216.                            until (i = entries) or match;
  1217.                            if not match
  1218.                                then begin
  1219.                                  writeln('Can''t locate ''', afName, ''' in ''', ifName, '''');
  1220.                                  writeln
  1221.                                end
  1222.                              else begin
  1223.                                start := get_dir_word(offset);
  1224.                                stop := get_dir_word(offset + 2);
  1225.                                file_type := get_dir_word(offset + 4);
  1226.                                if file_type <> 3
  1227.                                    then xlate := false;
  1228.                                assign(aof, dirName);
  1229.                                rewrite(aof);
  1230.                                if not xlate
  1231.                                    then begin
  1232.                                      for i := start to stop - 1
  1233.                                        do begin
  1234.                                          trkNo := i div 8;
  1235.                                          secNo := (i * 2) mod 16;
  1236.                                          BlockWrite(aof, sectors[trkNo][secNo], 4)
  1237.                                        end
  1238.                                    end
  1239.                                  else begin
  1240.                                    if start + 2 > stop - 1
  1241.                                        then writeln('Size problem in text file!')
  1242.                                      else begin
  1243.                                        indent := false;
  1244.                                        m := 0;
  1245.                                        fileSz := 0;
  1246.                                        for i := start + 2 to stop - 1
  1247.                                          do begin
  1248.                                            trkNo := i div 8;
  1249.                                            secNo := (i * 2) mod 16;
  1250.                                            for k := 0 to 1
  1251.                                              do begin
  1252.                                                j := 0;
  1253.                                                repeat
  1254.                                                  byt := sectors[trkNo][secNo + k][j];
  1255.                                                  if indent
  1256.                                                      then begin
  1257.                                                        if (byt < $20) or (byt > $7F)
  1258.                                                            then begin
  1259.                                                              writeln('Invalid indent value!');
  1260.                                                              writeIt := false
  1261.                                                            end
  1262.                                                          else if byt = $20
  1263.                                                                   then writeIt := false
  1264.                                                          else begin
  1265.                                                            count := byt - $20;
  1266.                                                            byt := $20;
  1267.                                                            writeIt := true
  1268.                                                          end;
  1269.                                                        indent := false
  1270.                                                      end
  1271.                                                    else begin
  1272.                                                      case byt of
  1273.                                                          0: writeIt := false;
  1274.                                                          $0D: begin
  1275.                                                                 byt := $0A;
  1276.                                                                 writeIt := true
  1277.                                                               end;
  1278.                                                          $10: begin
  1279.                                                                 indent := true;
  1280.                                                                 writeIt := false
  1281.                                                               end
  1282.                                                        else writeIt := true
  1283.                                                      end;
  1284.                                                      count := 1
  1285.                                                    end;
  1286.                                                  if writeIt
  1287.                                                      then begin
  1288.                                                        for n := 1 to count
  1289.                                                          do begin
  1290.                                                            workSector[m] := byt;
  1291.                                                            m := m + 1;
  1292.                                                            if m = 256
  1293.                                                                then begin
  1294.                                                                  BlockWrite(aof, workSector, 2);
  1295.                                                                  m := 0
  1296.                                                                end;
  1297.                                                            fileSz := fileSz + 1
  1298.                                                          end
  1299.                                                      end
  1300.                                                  j := j + 1
  1301.                                                until j = 256;
  1302.                                              end
  1303.                                          end;
  1304.                                        if m <> 0
  1305.                                            then BlockWrite(aof, workSector, 2)
  1306.                                      end
  1307.                                  end;
  1308.                                close(aof);
  1309.                                if xlate
  1310.                                    then begin  { Set file size }
  1311.                                      f := Open(dirName, MODE_OLDFILE);
  1312.                                      newSize := SetFileSize(f, fileSz, OFFSET_BEGINNING);
  1313.                                      if newSize <> fileSz
  1314.                                          then writeln('However unlikely, setting output file size failed!');
  1315.                                      _Close(f)
  1316.                                    end;
  1317.                                { Change date stamp }
  1318.                                formatDate(get_dir_byte(offset + 25),
  1319.                                                        get_dir_byte(offset + 24),
  1320.                                                        mDate);
  1321.                                mTime := '00:00';
  1322. {
  1323. writeln(mDate)
  1324. }
  1325.                                if not StrToDate(^dtWork)
  1326.                                    then writeln('''StrToDate'' failed!')
  1327.                                  else if not SetFileDate(dirName, ^dtWork.dat_Stamp)
  1328.                                           then writeln('Couldn''t change date stamp of ''', dirName, '''!');
  1329.                              end
  1330.                          end;
  1331.                  ProDOS: begin
  1332.                            entCount := sectors[0][4][36];
  1333.                            entSz := sectors[0][4][35];
  1334.                            match := false;
  1335.                            blkNo := 2;
  1336.                            repeat
  1337.                              trkNo := blkNo div 8;
  1338.                              secNo := (blkNo * 2) mod 16;
  1339.                              i := 0;
  1340.                              repeat
  1341.                                for j := 0 to entSz - 1
  1342.                                  do begin
  1343.                                    offs := i * entSz + j + 4;
  1344.                                    dirEnt[j] := sectors[trkNo][secNo + offs div 256][offs mod 256]
  1345.                                  end;
  1346.                                entTyp := dirEnt[0] shr 4;
  1347.                                if (entTyp >= 1) and (entTyp <= 3)
  1348.                                    then begin
  1349.                                      dirName := '';
  1350.                                      size := dirEnt[0] and $0F;
  1351.                                      for j := 1 to size
  1352.                                        do dirName := dirName
  1353.                                                      + UpCase(chr(dirEnt[j]))
  1354.                                    end;
  1355.                                match := dirName = afName;
  1356.                                i := i + 1
  1357.                              until (i = entCount) or match
  1358.                              if not match
  1359.                                  then blkNo := sectors[trkNo][secNo][3] * 256
  1360.                                                + sectors[trkNo][secNo][2]
  1361.                            until (blkNo = 0) or match;
  1362.                            if not match
  1363.                                then begin
  1364.                                  writeln('Can''t locate ''', afName, ''' in ''', ifName, '''');
  1365.                                  writeln
  1366.                                end
  1367.                              else begin
  1368.                                i := (dirEnt[0] and $F0) shr 4;
  1369.                                if (i < 1) or (i > 2)
  1370.                                    then writeln('Can''t handle file type!')
  1371.                                  else begin
  1372.                                    { get file size }
  1373.                                    fileSz :=  dirEnt[23] * 65536 + dirEnt[22] * 256 + dirEnt[21];
  1374.                                    start := dirEnt[18] * 256 + dirEnt[17];
  1375.                                    if i = 1
  1376.                                        then begin
  1377.                                          blocks := 1;
  1378.                                          blkAddrs[0] := start
  1379.                                        end
  1380.                                      else begin
  1381.                                        i := 0;
  1382.                                        trkNo := start div 8;
  1383.                                        secNo := (start * 2) mod 16;
  1384.                                        repeat
  1385.                                          blkNo := sectors[trkNo][secNo + 1][i]
  1386.                                                 * 256 + sectors[trkNo][secNo][i];
  1387.                                          blkAddrs[i] := blkNo;
  1388.                                          i := i + 1
  1389.                                        until blkNo = 0;
  1390.                                        blocks := i
  1391.                                      end;
  1392.                                    assign(aof, dirName);
  1393.                                    rewrite(aof);
  1394.                                    for i := 0 to blocks - 2
  1395.                                      do begin
  1396.                                        trkNo := blkAddrs[i] div 8;
  1397.                                        secNo := (blkAddrs[i] * 2) mod 16;
  1398.                                        if not xlate
  1399.                                            then BlockWrite(aof, sectors[trkNo][secNo], 4)
  1400.                                          else begin
  1401.                                            for k := 0 to 1
  1402.                                              do begin
  1403.                                                for j := 0 to 255
  1404.                                                  do begin
  1405.                                                    byt := sectors[trkNo][secNo + k][j];
  1406.                                                    if byt = $0D
  1407.                                                        then byt := $0A;
  1408.                                                    workSector[j] := byt
  1409.                                                  end;
  1410.                                                BlockWrite(aof, workSector, 2)
  1411.                                              end
  1412.                                          end
  1413.                                      end;
  1414.                                    close(aof);
  1415.                                    { Set file size }
  1416.                                          f := Open(dirName, MODE_OLDFILE);
  1417.                                          newSize := SetFileSize(f, fileSz, OFFSET_BEGINNING);
  1418.                                          if newSize <> fileSz
  1419.                                              then writeln('However unlikely, setting output file size failed!');
  1420.                                          _Close(f);
  1421.                                    { Change date stamp }
  1422.                                    formatDate(dirEnt[34], dirEnt[33], mDate);
  1423.                                    if mDate <> '<NO DATE>'
  1424.                                        then begin
  1425.                                          formatTime(dirEnt[36], dirEnt[35], mTime);
  1426.                                          if mTime[1] = ' '
  1427.                                              then mTime[1] := '0';
  1428.                                          if not StrToDate(^dtWork)
  1429.                                              then writeln('''StrToDate'' failed!')
  1430.                                            else if not SetFileDate(dirName, ^dtWork.dat_Stamp)
  1431.                                                     then writeln('Couldn''t change date stamp of ''', dirName, '''!');
  1432.                                       end
  1433.                                  end
  1434.                              end
  1435.                          end
  1436.                end
  1437.              end;
  1438.     delete: begin
  1439.             end;
  1440.     reord: begin
  1441.              if order = oPO
  1442.                  then begin
  1443.                    for i := 0 to 34
  1444.                      do begin
  1445.                        rearrTrack[0] := sectors[i][0];
  1446.                        rearrTrack[1] := sectors[i][14];
  1447.                        rearrTrack[2] := sectors[i][13];
  1448.                        rearrTrack[3] := sectors[i][12];
  1449.                        rearrTrack[4] := sectors[i][11];
  1450.                        rearrTrack[5] := sectors[i][10];
  1451.                        rearrTrack[6] := sectors[i][9];
  1452.                        rearrTrack[7] := sectors[i][8];
  1453.                        rearrTrack[8] := sectors[i][7];
  1454.                        rearrTrack[9] := sectors[i][6];
  1455.                        rearrTrack[10] := sectors[i][5];
  1456.                        rearrTrack[11] := sectors[i][4];
  1457.                        rearrTrack[12] := sectors[i][3];
  1458.                        rearrTrack[13] := sectors[i][2];
  1459.                        rearrTrack[14] := sectors[i][1];
  1460.                        rearrTrack[15] := sectors[i][15];
  1461.                        sectors[i] := rearrTrack
  1462.                      end;
  1463.                    ordCh := 'P'
  1464.                  end
  1465.                else ordCh := 'D';
  1466.              writeln('  Input file ''', ifName, ''' is in ''', ordCh, 'O'' order');
  1467.              writeln('  Output file is ''', ofName, '''');
  1468.              f := Open(ofName, MODE_NEWFILE);
  1469.              if _Write(f, ^sectors, secImSize) <> secImSize
  1470.                  then begin
  1471.                    writeln('Error writing reordered file!');
  1472.                    halt(20)
  1473.                  end;
  1474.              _Close(f);
  1475.              writeln
  1476.            end;
  1477.     cvt: begin
  1478.            for i := 0 to 34
  1479.              do begin
  1480.                rearrTrack[0] := sectors[i][0];
  1481.                rearrTrack[1] := sectors[i][14];
  1482.                rearrTrack[2] := sectors[i][13];
  1483.                rearrTrack[3] := sectors[i][12];
  1484.                rearrTrack[4] := sectors[i][11];
  1485.                rearrTrack[5] := sectors[i][10];
  1486.                rearrTrack[6] := sectors[i][9];
  1487.                rearrTrack[7] := sectors[i][8];
  1488.                rearrTrack[8] := sectors[i][7];
  1489.                rearrTrack[9] := sectors[i][6];
  1490.                rearrTrack[10] := sectors[i][5];
  1491.                rearrTrack[11] := sectors[i][4];
  1492.                rearrTrack[12] := sectors[i][3];
  1493.                rearrTrack[13] := sectors[i][2];
  1494.                rearrTrack[14] := sectors[i][1];
  1495.                rearrTrack[15] := sectors[i][15];
  1496.                sectors[i] := rearrTrack
  1497.              end
  1498.            f := Open(ofName, MODE_NEWFILE);
  1499.            if _Write(f, ^sectors, secImSize) <> secImSize
  1500.                then begin
  1501.                  writeln('Error writing sector image file!');
  1502.                  halt(20)
  1503.                end;
  1504.            _Close(f);
  1505.            writeln
  1506.          end
  1507.   end
  1508. end.
  1509.